home *** CD-ROM | disk | FTP | other *** search
- Option Explicit
- '
- ' These structures and declarations are specific to calling
- ' Common Dialogs
- '
-
-
- Type CD_OPENFILE_TYPE
- FilterIndex As Integer
- Filter As String
- hWnd As Integer
- Flags As Long
- Filename As String
- InitDir As String
- DefaultExt As String
- End Type
-
-
- Type OPENFILENAME_TYPE
- lStructSize As Long
- hwndOwner As Integer
- hInstance As Integer
- lpstrFilter As Long
- lpstrCustomFilter As Long
- nMaxCustFilter As Long
- nFilterIndex As Long
- lpstrFile As Long
- nMaxFile As Long
- lpstrFileTitle As Long
- nMaxFileTitle As Long
- lpstrInitialDir As Long
- lpstrTitle As Long
- Flags As Long
- nFileOffset As Integer
- nFileExtension As Integer
- lpstrDefExt As Long
- lCustData As Long
- lpfnHook As Long
- lpTemplateName As Long
- End Type
-
- Declare Function GetOpenFileName Lib "COMMDLG.DLL" (lpOPENFILENAME As OPENFILENAME_TYPE) As Integer
- Declare Function GetSaveFileName Lib "COMMDLG.DLL" (lpOPENFILENAME As OPENFILENAME_TYPE) As Integer
- Declare Function GetFileTitle Lib "COMMDLG.DLL" (ByVal FName As String, ByVal Title As String, Size As Integer)
-
- Global Const OFN_READONLY = &H1
- Global Const OFN_OVERWRITEPROMPT = &H2
- Global Const OFN_HIDEREADONLY = &H4
- Global Const OFN_NOCHANGEDIR = &H8
- Global Const OFN_SHOWHELP = &H10
- Global Const OFN_ENABLEHOOK = &H20
- Global Const OFN_ENABLETEMPLATE = &H40
- Global Const OFN_ENABLETEMPLATEHANDLE = &H80
- Global Const OFN_NOVALIDATE = &H100
- Global Const OFN_ALLOWMULTISELECT = &H200
- Global Const OFN_EXTENSIONDIFFERENT = &H400
- Global Const OFN_PATHMUSTEXIST = &H800
- Global Const OFN_FILEMUSTEXIST = &H1000
- Global Const OFN_CREATEPROMPT = &H2000
- Global Const OFN_SHAREAWARE = &H4000
- Global Const OFN_NOREADONLYRETURN = &H8000
- Global Const OFN_NOTESTFILECREATE = &H10000
-
- Global Const OFN_SHAREFALLTHROUGH = 2
- Global Const OFN_SHARENOWARN = 1
- Global Const OFN_SHAREWARN = 0
-
- Type PRINTDLG_TYPE
- lStructSize As Long
- hwndOwner As Integer
- hDevMode As Integer
- hDevNames As Integer
- hDC As Integer
- Flags As Long
- nFromPage As Integer
- nToPage As Integer
- nMinPage As Integer
- nMaxPage As Integer
- nCopies As Integer
- hInstance As Integer
- lCustData As Long
- lpfnPrintHook As Long
- lpfnSetupHook As Long
- lpPrintTemplateName As Long
- lpSetupTemplateName As Long
- hPrintTemplate As Integer
- hSetupTemplate As Integer
- End Type
-
- Declare Function PrintDlg Lib "COMMDLG.DLL" (pPrintDLG As PRINTDLG_TYPE) As Integer
-
- Global Const PD_ALLPAGES = &H0
- Global Const PD_SELECTION = &H1
- Global Const PD_PAGENUMS = &H2
- Global Const PD_NOSELECTION = &H4
- Global Const PD_NOPAGENUMS = &H8
- Global Const PD_COLLATE = &H10
- Global Const PD_PRINTTOFILE = &H20
- Global Const PD_PRINTSETUP = &H40
- Global Const PD_NOWARNING = &H80
- Global Const PD_RETURNDC = &H100
- Global Const PD_RETURNIC = &H200
- Global Const PD_RETURNDEFAULT = &H400
- Global Const PD_SHOWHELP = &H800
- Global Const PD_ENABLEPRINTHOOK = &H1000
- Global Const PD_ENABLESETUPHOOK = &H2000
- Global Const PD_ENABLEPRINTTEMPLATE = &H4000
- Global Const PD_ENABLESETUPTEMPLATE = &H8000
- Global Const PD_ENABLEPRINTTEMPLATEHANDLE = &H10000
- Global Const PD_ENABLESETUPTEMPLATEHANDLE = &H20000
- Global Const PD_USEDEVMODECOPIES = &H40000
- Global Const PD_DISABLEPRINTTOFILE = &H80000
- Global Const PD_HIDEPRINTTOFILE = &H100000
-
- Type DEVNAMES
- wDriverOffset As Integer
- wDeviceOffset As Integer
- wOutputOffset As Integer
- wDefault As Integer
- End Type
-
- Type DEVMODE_TYPE
- dmDeviceName As String * 32
- dmSpecVersion As Integer
- dmDriverVersion As Integer
- dmSize As Integer
- dmDriverExtra As Integer
- dmFields As Long
- dmOrientation As Integer
- dmPaperSize As Integer
- dmPaperLength As Integer
- dmPaperWidth As Integer
- dmScale As Integer
- dmCopies As Integer
- dmDefaultSource As Integer
- dmPrintQuality As Integer
- dmColor As Integer
- dmDuplex As Integer
- dmYResolution As Integer
- dmTTOption As Integer
- End Type
-
-
- Global Const DN_DEFAULTPRN = &H1
-
- 'retrieves error value
- Declare Function CommDlgExtendedError Lib "COMMDLG.DLL" () As Long
-
- '************************* end of Common Dialogs Declares ************
-
- Sub CD_OpenFile (CD_OF As CD_OPENFILE_TYPE)
- Dim OFN As OPENFILENAME_TYPE
- Dim X As Integer
- Dim Handle As Integer
-
- Handle = Prepare_OFN(CD_OF, OFN)
-
- If Handle Then
-
- X = GetOpenFileName(OFN)
-
- If X Then
- Call hmemcpy(ByVal CD_OF.Filename, ByVal OFN.lpstrFile, Len(CD_OF.Filename))
- End If
- CD_OF.Filename = Left$(CD_OF.Filename, InStr(CD_OF.Filename, Chr$(0)) - 1)
- X = GlobalUnlock(Handle)
- X = GlobalFree(Handle)
- End If
- End Sub
-
- Sub CD_SaveFile (CD_FS As CD_OPENFILE_TYPE)
- Dim OFN As OPENFILENAME_TYPE
- Dim X As Integer
- Dim Handle As Integer
-
- Handle = Prepare_OFN(CD_FS, OFN)
- If Handle Then
- X = GetSaveFileName(OFN)
- If X Then
- Call hmemcpy(ByVal CD_FS.Filename, ByVal OFN.lpstrFile, Len(CD_FS.Filename))
- CD_FS.Filename = Left$(CD_FS.Filename, InStr(CD_FS.Filename, Chr$(0)) - 1)
- Else
- CD_FS.Filename = ""
- End If
-
- X = GlobalUnlock(Handle)
- X = GlobalFree(Handle)
- End If
- End Sub
-
- Sub PageSetup ()
- Dim X As Integer
- Dim Address As Long
- Dim P As PRINTDLG_TYPE
- Dim D As DEVMODE_TYPE
-
- P.lStructSize = Len(P)
- P.hwndOwner = Forms(0).hWnd
- P.Flags = PD_RETURNIC Or PD_HIDEPRINTTOFILE
- P.nFromPage = 1
- P.nToPage = 999
- P.nMinPage = 1
- P.nMaxPage = 999
- P.nCopies = 1
- X = PrintDlg(P)
-
- If X Then
- If P.hDC Then X = DeleteDC(P.hDC)
- If P.hDevNames Then X = GlobalFree(P.hDevNames)
-
- Address = GlobalLock(P.hDevMode)
- Call hmemcpy(D, ByVal Address, Len(D))
- X = GlobalUnlock(P.hDevMode)
- X = GlobalFree(P.hDevMode)
-
- ' Print "Printer:", Left$(D.dmDeviceName, InStr(D.dmDeviceName, Chr$(0)) - 1)
- ' Print "From Page:", P.nFromPage
- ' Print "To Page:", P.nToPage
- ' Print "Copies:", P.nCopies
- End If
- End Sub
-
- Private Function Prepare_OFN (CD_OF As CD_OPENFILE_TYPE, OFN As OPENFILENAME_TYPE) As Integer
- Dim Handle As Integer
-
- Do While InStr(CD_OF.Filter, "|") > 0
- Mid$(CD_OF.Filter, InStr(CD_OF.Filter, "|")) = Chr(0)
- Loop
-
- CD_OF.InitDir = CD_OF.InitDir & Chr(0)
- CD_OF.DefaultExt = CD_OF.DefaultExt & Chr(0)
- CD_OF.Filename = CD_OF.Filename & String$(256, Chr(0))
- CD_OF.Filter = CD_OF.Filter & Chr$(0)
-
- Handle = GlobalAlloc(GHND, Len(CD_OF.Filename))
-
- If Handle Then
- OFN.lpstrFile = GlobalLock(Handle)
- Call hmemcpy(ByVal OFN.lpstrFile, ByVal CD_OF.Filename, Len(CD_OF.Filename))
- If CD_OF.hWnd = 0 Then CD_OF.hWnd = Forms(0).hWnd
- OFN.lStructSize = Len(OFN)
- OFN.hwndOwner = CD_OF.hWnd
- OFN.Flags = CD_OF.Flags
- OFN.nFilterIndex = CD_OF.FilterIndex
- OFN.nMaxFile = 256
- OFN.lpstrFilter = MemAddr(CD_OF.Filter)
- OFN.lpstrInitialDir = MemAddr(CD_OF.InitDir)
- OFN.lpstrDefExt = MemAddr(CD_OF.DefaultExt)
- End If
- Prepare_OFN = Handle
- End Function
-
- Sub PrinterSetup ()
- Dim X As Integer
- Dim Address As Long
- Dim P As PRINTDLG_TYPE
- Dim D As DEVMODE_TYPE
-
- P.lStructSize = Len(P)
- P.hwndOwner = Forms(0).hWnd
- P.Flags = PD_PRINTSETUP
- X = PrintDlg(P)
-
- If X Then
- 'PrintDlg() returns an hDC, a global handle to hDevNames
- 'and another to hDevMode. Delete the ones we don't need
- If P.hDC Then X = DeleteDC(P.hDC)
- If P.hDevNames Then X = GlobalFree(P.hDevNames)
-
- 'Make a local copy of the global block (hDevMode)
- Address = GlobalLock(P.hDevMode)
- Call hmemcpy(D, ByVal Address, Len(D))
-
- X = GlobalUnlock(P.hDevMode) 'free the memory
- X = GlobalFree(P.hDevMode)
-
- ' Print "Printer:", Left$(D.dmDeviceName, InStr(D.dmDeviceName, Chr$(0)) - 1)
- ' Print "Orientation:", D.dmOrientation
- End If
- End Sub
-
-